Developer CD Series 1995…tember: Reference Library/Dev.CD Sep 95 RL/Dev.CD Sep 95 RL.toast/mac/Technical Documentation/develop/develop Issue 23 code/Internet Config/IC 1.1/ICProgKit1.1/Source/Internet Config Source/ICRSubs.p

Text File | 1995-04-23 | 8.6 KB | 317 lines | [TEXT/PJMM]

unit ICRSubs;

interface

    uses
{$ifc undefined THINK_Pascal}
        Types, Files,
{$endc}
        ICTypes;

    function EditPreferences (key: Str255; prefsfile: FSSpec): ICError;

    function FindScheme (urlh: Handle; var scheme: Str255): ICError;
    function LaunchURL (helper: OSType; urlh: Handle): ICError;

implementation

    uses
{$ifc undefined THINK_Pascal}
        GestaltEqu, Errors, ToolUtils,
{$endc}
        Processes, AppleEvents;

    function HaveProcessManager: ICError;
        var
            gv: longint;
    begin
        if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchControl)) then begin
            HaveProcessManager := noErr;
        end
        else begin
            HaveProcessManager := unimpErr;
        end; (* if *)
    end; (* HaveProcessManager *)

    function FindProcess (creator, typ: OSType; var process: ProcessSerialNumber; var fs: FSSpec): boolean;
        var
            info: ProcessInfoRec;
            oe: OSErr;
            gv: longInt;
    begin
        FindProcess := false;
        if HaveProcessManager = noErr then begin
            process.highLongOfPSN := 0;
            process.lowLongOfPSN := kNoProcess;
            info.processInfoLength := sizeof(ProcessInfoRec);
            info.processName := nil;
            info.processAppSpec := @fs;
            while GetNextProcess(process) = noErr do begin
                if (GetProcessInformation(process, info) = noErr) & (info.processType = longInt(typ)) & (info.processSignature = creator) then begin
                    FindProcess := true;
                    leave;
                end; (* if *)
            end; (* while *)
        end; (* if *)
    end; (* FindProcess *)

    function GetVolInfo (var name: str63; var vrn: integer; index: integer): OSErr;
        var
            pb: paramBlockRec;
            oe: OSErr;
    begin
        if (name <> '') & (name[length(name)] <> ':') then begin
            name := concat(name, ':');
        end; (* if *)
        pb.ioNamePtr := @name;
        pb.ioVRefNum := vrn;
        pb.ioVolIndex := index;
        oe := PBGetVInfo(@pb, false);
        if oe = noErr then begin
            vrn := pb.ioVRefNum;
        end; (* if *)
        GetVolInfo := oe;
    end; (* GetVolInfo *)

    function ConfirmAppl (creator: OSType; var fss: FSSpec): OSErr;
        var
            err: OSErr;
            info: FInfo;
    begin
        err := HGetFInfo(fss.vRefNum, fss.parID, fss.name, info);
        if err = noErr then begin
            if (info.fdType <> 'APPL') or (info.fdCreator <> creator) then begin
                err := afpItemNotFound;
            end; (* if *)
        end; (* if *)
        ConfirmAppl := err;
    end; (* ConfirmAppl *)

    function ScanVolume (creator: OSType; vref: integer; var fs: FSSpec): OSErr;
        var
            err: OSErr;
            file_index: integer;
            pbdt: DTPBRec;
            found: boolean;
    begin
        fs.name := '';
        pbdt.ioNamePtr := @fs.name;
        pbdt.ioVRefNum := vref;
        err := PBDTGetPath(@pbdt);
        if err = noErr then begin
            file_index := 1;
            found := false;
            repeat
                pbdt.ioIndex := file_index;
                pbdt.ioFileCreator := creator;
                err := PBDTGetAPPLSync(@pbdt);
                if err = noErr then begin
                    fs.vRefNum := vref;
                    fs.parID := pbdt.ioAPPLParID;
                    (* name is already put in by GetAPPL call *)
                    found := (ConfirmAppl(creator, fs) = noErr);
                end; (* if *)
                file_index := file_index + 1;
            until found or (err <> noErr);
        end; (* if *)
        ScanVolume := err;
    end; (* ScanVolume *)

    function FindApplication (creator: OSType; var fs: FSSpec): OSErr;
        var
            err: OSErr;
            vol_index: integer;
            vref: integer;
            found: boolean;
    begin
        found := false;
        vol_index := 1;
        repeat
            vref := 0;
            err := GetVolInfo(fs.name, vref, vol_index);
            if err = noErr then begin
                err := ScanVolume(creator, vref, fs);
                if err = noErr then begin
                    found := true;
                end
                else begin
                    err := noErr;        (* swallow error so we continue with next volume *)
                end; (* if *)
            end; (* if *)
            vol_index := vol_index + 1;
        until found or (err <> noErr);
        if not found then begin
            err := afpItemNotFound;
            fs.vRefNum := 0;
            fs.parID := 2;
            fs.name := '';
        end; (* if *)
        FindApplication := err;
    end; (* FindApplication *)

    function PrepareToLaunch (var theEvent: AppleEvent; tofront: boolean; var launchThis: LaunchParamBlockRec): ICError;
        var
            launchDesc: AEDesc;
    begin
        PrepareToLaunch := AECoerceDesc(theEvent, typeAppParameters, launchDesc);
        HLock(handle(theEvent.dataHandle));
        launchThis.launchAppParameters := AppParametersPtr(launchDesc.dataHandle^);
        launchThis.launchBlockID := extendedBlock;
        launchThis.launchEPBLength := extendedBlockLen;
        launchThis.launchFileFlags := 0;
        launchThis.launchControlFlags := launchContinue + launchNoFileFlags;
        if not tofront then begin
            launchThis.launchControlFlags := launchThis.launchControlFlags + launchDontSwitch;
        end; (* if *)
    end; (* PrepareToLaunch *)

    function CreateGURLEvent (creator: OSType; urlh: Handle; var theEvent: AppleEvent): ICError;
        var
            targetAddress: AEDesc;
            err: ICError;
            junk: ICError;
            err2: ICError;
            s: signedByte;
    begin
        err := AECreateDesc(typeApplSignature, @creator, sizeof(creator), targetAddress);
        err2 := AECreateAppleEvent('GURL', 'GURL', targetAddress, kAutoGenerateReturnID, kAnyTransactionID, theEvent);
        if err = noErr then begin
            err := err2;
        end; (* if *)
        s := HGetState(urlh);
        HLock(urlh);
        err2 := AEPutKeyPtr(theEvent, keyDirectObject, typeChar, urlh^, GetHandleSize(urlh));
        HSetState(urlh, s);
        if err = noErr then begin
            err := err2;
        end; (* if *)
        if err <> noErr then begin
            junk := AEDisposeDesc(theEvent);
        end; (* if *)
        junk := AEDisposeDesc(targetAddress);
        CreateGURLEvent := err;
    end; (* CreateGURLEvent *)

    function CreateEditPrefEvent (creator: OSType; key: Str255; prefsfile: FSSpec; var theEvent: AppleEvent): ICError;
        var
            targetAddress: AEDesc;
            err: ICError;
            junk: ICError;
            err2: ICError;
    begin
        err := AECreateDesc(typeApplSignature, @creator, sizeof(creator), targetAddress);
        err2 := AECreateAppleEvent('ICAp', 'ICAp', targetAddress, kAutoGenerateReturnID, kAnyTransactionID, theEvent);
        if err = noErr then begin
            err := err2;
        end; (* if *)
        err2 := AEPutKeyPtr(theEvent, '----', 'TEXT', @key[1], length(key));
        if err = noErr then begin
            err := err2;
        end; (* if *)
        err2 := AEPutKeyPtr(theEvent, 'dest', 'fss ', @prefsfile, sizeof(prefsfile));
        if err = noErr then begin
            err := err2;
        end; (* if *)
        if err <> noErr then begin
            junk := AEDisposeDesc(theEvent);
        end; (* if *)
        junk := AEDisposeDesc(targetAddress);
        CreateEditPrefEvent := err;
    end; (* CreateEditPrefEvent *)

    function LaunchFSSpec (var fs: FSSpec; theEvent: AppleEvent): ICError;
        var
            launchThis: LaunchParamBlockRec;
            launchDesc: AEDesc;
            err: ICError;
    begin
        launchThis.launchAppSpec := @fs;
        err := PrepareToLaunch(theEvent, true, launchThis);
        if err = noErr then begin
            err := LaunchApplication(@launchThis);
        end; (* if *)
        if err = memFullErr then begin
            launchThis.launchControlFlags := bor(launchThis.launchControlFlags, launchUseMinimum);
            err := LaunchApplication(@launchThis);
        end; (* if *)
        LaunchFSSpec := err;
    end; (* LaunchFSSpec *)

    function SendEvent (theEvent: AppleEvent; creator: OSType): ICError;
        var
            err: ICError;
            psn: ProcessSerialNumber;
            app_fs: FSSpec;
            junk: ICError;
            reply: AppleEvent;
    begin
        if FindProcess(creator, 'APPL', psn, app_fs) then begin
            junk := SetFrontProcess(psn);
            err := AESend(theEvent, reply, kAENoReply, kAEHighPriority, kNoTimeOut, nil, nil);
        end
        else begin
            err := FindApplication(creator, app_fs);
            if err = noErr then begin
                err := LaunchFSSpec(app_fs, theEvent);
            end; (* if *)
        end; (* if *)
        SendEvent := err;
    end; (* SendEvent *)

    function EditPreferences (key: Str255; prefsfile: FSSpec): ICError;
        var
            err: ICError;
            junk: ICError;
            theEvent: AppleEvent;
    begin
        err := HaveProcessManager;
        if err = noErr then begin
            err := CreateEditPrefEvent(ICcreator, key, prefsfile, theEvent);
            if err = noErr then begin
                err := SendEvent(theEvent, ICcreator);
            end; (* if *)
            junk := AEDisposeDesc(theEvent);
        end; (* if *)
        EditPreferences := err;
    end; (* EditPreferences *)

    function FindScheme (urlh: Handle; var scheme: Str255): ICError;
        var
            err: ICError;
            tmp: Str15;
            ndx: longint;
    begin
        err := noErr;
        tmp := ':';
        ndx := Munger(Handle(urlh), 0, @tmp[1], length(tmp), nil, 0);
        if (ndx < 0) or (ndx > 255) then begin
            err := icNoURLErr;
        end; (* if *)
        if err = noErr then begin
{$push}
{$r-}
            scheme[0] := chr(ndx);
            BlockMove(urlh^, @scheme[1], ndx);
{$pop}
        end; (* if *)
        FindScheme := err;
    end; (* FindScheme *)

    function LaunchURL (helper: OSType; urlh: Handle): ICError;
        var
            err: ICError;
            junk: ICError;
            theEvent: AppleEvent;
    begin
        err := HaveProcessManager;
        if err = noErr then begin
            err := CreateGURLEvent(helper, urlh, theEvent);
            if err = noErr then begin
                err := SendEvent(theEvent, helper);
            end; (* if *)
            junk := AEDisposeDesc(theEvent);
        end; (* if *)
        LaunchURL := err;
    end; (* LaunchURL *)

end. (* ICRSubs *)